home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / aandbf1g / form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-22  |  10.1 KB  |  309 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Generic Multiple CD Player"
  5.    ClientHeight    =   1905
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   7065
  9.    Icon            =   "Form1.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   1905
  13.    ScaleWidth      =   7065
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.Timer Timer1 
  16.       Interval        =   1000
  17.       Left            =   4200
  18.       Top             =   960
  19.    End
  20.    Begin VB.CommandButton Command8 
  21.       Caption         =   "About..."
  22.       Height          =   255
  23.       Left            =   120
  24.       TabIndex        =   11
  25.       Top             =   120
  26.       Width           =   1215
  27.    End
  28.    Begin VB.PictureBox Picture1 
  29.       BackColor       =   &H00004040&
  30.       Height          =   735
  31.       Left            =   2520
  32.       ScaleHeight     =   675
  33.       ScaleWidth      =   4395
  34.       TabIndex        =   9
  35.       Top             =   120
  36.       Width           =   4455
  37.       Begin VB.Image Image1 
  38.          Height          =   330
  39.          Left            =   0
  40.          Picture         =   "Form1.frx":08CA
  41.          Top             =   0
  42.          Width           =   2340
  43.       End
  44.       Begin VB.Label Label3 
  45.          Alignment       =   1  'Right Justify
  46.          BackStyle       =   0  'Transparent
  47.          BeginProperty Font 
  48.             Name            =   "Arial"
  49.             Size            =   15.75
  50.             Charset         =   0
  51.             Weight          =   700
  52.             Underline       =   0   'False
  53.             Italic          =   0   'False
  54.             Strikethrough   =   0   'False
  55.          EndProperty
  56.          ForeColor       =   &H0000C0C0&
  57.          Height          =   495
  58.          Left            =   1680
  59.          TabIndex        =   12
  60.          Top             =   120
  61.          Width           =   2535
  62.       End
  63.       Begin VB.Label Label2 
  64.          BackColor       =   &H00008080&
  65.          BackStyle       =   0  'Transparent
  66.          Caption         =   "Current CD Drive"
  67.          ForeColor       =   &H0000C0C0&
  68.          Height          =   255
  69.          Left            =   120
  70.          TabIndex        =   10
  71.          Top             =   360
  72.          Width           =   3135
  73.       End
  74.    End
  75.    Begin VB.CommandButton Command7 
  76.       Caption         =   "Close"
  77.       Height          =   495
  78.       Left            =   6120
  79.       TabIndex        =   7
  80.       Top             =   1320
  81.       Width           =   855
  82.    End
  83.    Begin VB.CommandButton Command6 
  84.       Caption         =   "Eject"
  85.       Height          =   495
  86.       Left            =   5280
  87.       TabIndex        =   6
  88.       Top             =   1320
  89.       Width           =   855
  90.    End
  91.    Begin VB.CommandButton CD 
  92.       Height          =   255
  93.       Index           =   0
  94.       Left            =   120
  95.       TabIndex        =   5
  96.       Top             =   960
  97.       Visible         =   0   'False
  98.       Width           =   735
  99.    End
  100.    Begin VB.CommandButton Command5 
  101.       Caption         =   "Stop"
  102.       Height          =   495
  103.       Left            =   3960
  104.       TabIndex        =   4
  105.       Top             =   1320
  106.       Width           =   1095
  107.    End
  108.    Begin VB.CommandButton Command4 
  109.       Caption         =   "Pause"
  110.       Height          =   495
  111.       Left            =   3000
  112.       TabIndex        =   3
  113.       Top             =   1320
  114.       Width           =   975
  115.    End
  116.    Begin VB.CommandButton Command3 
  117.       Caption         =   "Track>>"
  118.       Height          =   495
  119.       Left            =   2040
  120.       TabIndex        =   2
  121.       Top             =   1320
  122.       Width           =   975
  123.    End
  124.    Begin VB.CommandButton Command2 
  125.       Caption         =   "Play"
  126.       Height          =   495
  127.       Left            =   1080
  128.       TabIndex        =   1
  129.       Top             =   1320
  130.       Width           =   975
  131.    End
  132.    Begin VB.CommandButton Command1 
  133.       Caption         =   "<<Track"
  134.       Height          =   495
  135.       Left            =   120
  136.       TabIndex        =   0
  137.       Top             =   1320
  138.       Width           =   975
  139.    End
  140.    Begin VB.Label Label1 
  141.       Caption         =   "Available Audio CD Drives"
  142.       Height          =   255
  143.       Left            =   120
  144.       TabIndex        =   8
  145.       Top             =   720
  146.       Width           =   2055
  147.    End
  148. Attribute VB_Name = "Form1"
  149. Attribute VB_GlobalNameSpace = False
  150. Attribute VB_Creatable = False
  151. Attribute VB_PredeclaredId = True
  152. Attribute VB_Exposed = False
  153. Dim CurrentCd As String
  154. Dim mssg As String * 255
  155. Public Sub Detect_CDs()
  156. Dim SmallString As String
  157. Dim NextDrive As String
  158. Static z As Integer
  159.        
  160. alldrives$ = Space$(64)
  161. 'Get all drives on your PC as one long string
  162. ret& = GetLogicalDriveStrings(Len(alldrives$), alldrives$)
  163. 'trim off any trailing spaces. AllDrives$
  164. 'now contains all the drive letters.
  165. alldrives$ = Left$(alldrives$, ret&)
  166. ' "AllDrives$"  contains a string of all of your drives
  167. 'in your computer, but there is a character "chr$(0)"
  168. 'between each drive letter that we must filter out.
  169. 'We will use the "FOR NEXT" function to do this.
  170. For k = 1 To Len(alldrives$)
  171.   SmallString = Mid$(alldrives$, k, 1) 'Get one character at a time
  172.   If SmallString = Chr$(0) Then
  173.            SmallString = ""     'remove unwanted character
  174.            DriveType& = GetDriveType(NextDrive) 'Check if it is a CD drive
  175.            If DriveType = 5 Then
  176.               If CD(0).Caption = "" Then 'Our first button needs to be updated before the others.
  177.                 CD(0).Caption = UCase$(NextDrive)
  178.                 CD(z).Visible = True
  179.                 CurrentCd = UCase$(NextDrive)
  180.               Else
  181.                 'Since this is a CD drive, make a button for it.
  182.                 'This code below creates command buttons
  183.                  z = z + 1
  184.                  Load CD(z)
  185.                  CD(z).Caption = UCase$(NextDrive)
  186.                  CD(z).Left = (CD(z - 1).Left) + (CD(z - 1).Width)
  187.                  CD(z).Visible = True
  188.               End If
  189.            End If
  190.            NextDrive = "" 'Now that a drive was detected, clear the
  191.                           'string for new info
  192.     End If
  193.       
  194. NextDrive = NextDrive & SmallString
  195. Next k
  196. If CD(0).Caption = "" Then
  197.   MsgBox "No Audio CDs were detected", vbInformation, ""
  198.   End
  199. UpDate_Cds
  200. End If
  201. End Sub
  202. Private Sub CD_Click(Index As Integer)
  203.   i = mciSendString("stop cd", 0&, 0, 0)
  204.   i = mciSendString("close cd", 0&, 0, 0)
  205.   CurrentCd = CD(Index).Caption
  206. UpDate_Cds
  207. End Sub
  208. Private Sub Command1_Click()
  209. Dim numTracks As Integer
  210. Dim CurTrack As Integer
  211. 'Get the current track
  212. rc = mciSendString("status cd current track", mssg, 255, 0)
  213. CurTrack = Str(mssg)
  214. 'Get total number of tracks
  215. rc = mciSendString("status cd number of tracks wait", mssg, 255, 0)
  216. numTracks = Str(mssg)
  217. 'Check to see if CD is playing
  218. rc = mciSendString("status cd mode", mssg, 255, 0)
  219. If Left$(mssg, 7) = "playing" Then
  220.     If CurTrack = 1 Then
  221.          rc = mciSendString("play cd from " & numTracks, mssg, 255, 0)
  222.     Else
  223.          rc = mciSendString("play cd from " & CurTrack - 1, mssg, 255, 0)
  224.     End If
  225.     If CurTrack = 1 Then
  226.          rc = mciSendString("seek cd to " & numTracks, mssg, 255, 0)
  227.     Else
  228.          rc = mciSendString("seek cd to " & CurTrack - 1, mssg, 255, 0)
  229.     End If
  230. End If
  231. End Sub
  232. Private Sub Command2_Click()
  233.   i = mciSendString("play cd", 0&, 0, 0)
  234. End Sub
  235. Private Sub Command3_Click()
  236. Dim mssg As String * 255
  237. Dim numTracks As Integer
  238. Dim CurTrack As Integer
  239. 'Get the current track
  240. rc = mciSendString("status cd current track", mssg, 255, 0)
  241. CurTrack = Str(mssg)
  242. 'Get total number of tracks
  243. rc = mciSendString("status cd number of tracks wait", mssg, 255, 0)
  244. numTracks = Str(mssg)
  245. 'Check to see if CD is playing
  246. rc = mciSendString("status cd mode", mssg, 255, 0)
  247. If Left$(mssg, 7) = "playing" Then
  248.     If CurTrack = numTracks Then
  249.          rc = mciSendString("play cd from 1", mssg, 255, 0)
  250.     Else
  251.          rc = mciSendString("play cd from " & CurTrack + 1, mssg, 255, 0)
  252.     End If
  253.     If CurTrack = numTracks Then
  254.          rc = mciSendString("seek cd to 1", mssg, 255, 0)
  255.     Else
  256.          rc = mciSendString("seek cd to " & CurTrack + 1, mssg, 255, 0)
  257.     End If
  258. End If
  259. End Sub
  260. Private Sub Command4_Click()
  261.   i = mciSendString("pause cd wait", 0&, 0, 0)
  262. End Sub
  263. Private Sub Command5_Click()
  264.   i = mciSendString("stop cd wait", 0&, 0, 0)
  265.   i = mciSendString("seek cd to 1 wait", 0&, 0, 0)
  266. End Sub
  267. Private Sub Command6_Click()
  268. i = mciSendString("set cd door open wait", mssg, 255, 0)
  269. End Sub
  270. Private Sub Command7_Click()
  271. i = mciSendString("status cd mode", mssg, 255, 0)
  272. If Left$(mssg, 4) = "open" Then
  273.    i = mciSendString("set cd door closed wait", mssg, 255, 0)
  274. End If
  275. End Sub
  276. Private Sub Command8_Click()
  277. 'Show form2 (About box) and disable form1
  278. Form2.Show 1
  279. End Sub
  280. Private Sub Form_Load()
  281. ' If we're already running, then quit
  282. If (App.PrevInstance = True) Then
  283.     End
  284. End If
  285. Detect_CDs
  286. End Sub
  287. Private Sub Form_Unload(Cancel As Integer)
  288.   i = mciSendString("stop cd", 0&, 0, 0)
  289.   i = mciSendString("close cd", 0&, 0, 0)
  290.   i = mciSendString("close all", 0&, 0, 0)
  291. End Sub
  292. Public Sub UpDate_Cds()
  293.   i = mciSendString("open  " & CurrentCd & " type cdaudio alias cd wait shareable", 0&, 0, 0)
  294.   i = mciSendString("set cd time format tmsf", 0&, 0, 0)
  295.   Label2.Caption = "Current CD Drive = " & CurrentCd
  296. End Sub
  297. Private Sub Timer1_Timer()
  298. ' Check if CD is in the player
  299. i = mciSendString("status cd media present", mssg, 255, 0)
  300. If Left$(mssg, 4) = "true" Then
  301.    i = mciSendString("status cd position", mssg, 255, 0)
  302.    track = CInt(Mid$(mssg, 1, 2))
  303.    Min = CInt(Mid$(mssg, 4, 2))
  304.    sec = CInt(Mid$(mssg, 7, 2))
  305.    Label3.Caption = "[" & Format(track, "00") & "] " & Format(Min, "00") & ":" & Format(sec, "00")
  306.    Label3.Caption = ""
  307. End If
  308. End Sub
  309.